﻿
Option Strict On

Imports System.IO
Imports System.IO.Compression
Imports System.Net
Imports System.Runtime.CompilerServices
Imports System.Text
Imports System.Web
Imports osi.root.connector
Imports osi.root.constants
Imports osi.root.formation
Imports osi.root.procedure
Imports osi.root.utils
Imports osi.service.http.constants
Imports osi.service.http.constants.request_method

Public Module _client
    Public Const undefined_content_length As Int64 = npos
    Private ReadOnly default_max_service_point_idle_time As Int32

    Sub New()
        assert(npos < 0)
        ServicePointManager.DefaultConnectionLimit() = max_int32
        ServicePointManager.MaxServicePoints() = max_int32
        ServicePointManager.UseNagleAlgorithm() = False
        default_max_service_point_idle_time = ServicePointManager.MaxServicePointIdleTime()
    End Sub

    Public Sub set_connection_reuse(ByVal enable As Boolean)
        If enable Then
            enable_connection_reuse()
        Else
            disable_connection_reuse()
        End If
    End Sub

    Public Sub enable_connection_reuse()
        ServicePointManager.MaxServicePointIdleTime() = default_max_service_point_idle_time
    End Sub

    Public Sub disable_connection_reuse()
        ServicePointManager.MaxServicePointIdleTime() = 0
    End Sub

    Public Function has_request_body(ByVal request_body As Stream,
                                     ByVal request_length As Int64) As Boolean
        Return Not request_body Is Nothing AndAlso request_length <> 0
    End Function

    Public Function decide_request_method(ByVal request_body As Stream,
                                          ByVal request_length As Int64) As request_method
        Return If(has_request_body(request_body, request_length), request_method.POST, request_method.GET)
    End Function

    <Extension()> Public Sub close(ByVal this As pointer(Of HttpWebResponse))
        If Not (+this) Is Nothing Then
            this.get().Close()
        End If
    End Sub

    <Extension()> Public Function url_encoded_parameters(ByVal i As map(Of String, String),
                                                         Optional ByVal e As Text.Encoding = Nothing) As String
        If i Is Nothing Then
            Return Nothing
        Else
            If e Is Nothing Then
                e = default_encoding
            End If
            Dim it As map(Of String, String).iterator = Nothing
            it = i.begin()
            Dim r As StringBuilder = Nothing
            r = New StringBuilder()
            While it <> i.end()
                If r.Length() > 0 Then
                    r.Append(constants.uri.argument_separator)
                End If
                r.Append(HttpUtility.UrlEncode((+it).first, e)) _
                 .Append(constants.uri.argument_name_value_separator) _
                 .Append(HttpUtility.UrlEncode((+it).second, e))
                it = DirectCast(it + 1, map(Of String, String).iterator)
            End While
            Return Convert.ToString(r)
        End If
    End Function

    'always start from /, so it can be used directly in http request
    <Extension()> Public Function url_encoded_path(ByVal i As vector(Of String),
                                                   Optional ByVal e As Text.Encoding = Nothing) As String
        If i Is Nothing OrElse i.empty() Then
            Return constants.uri.path_separator
        Else
            Dim o As StringBuilder = Nothing
            o = New StringBuilder()
            For j As Int32 = 0 To CInt(i.size()) - 1
                o.Append(constants.uri.path_separator) _
                 .Append(uri_path_encode(i(CUInt(j)), e))
            Next
            Return Convert.ToString(o)
        End If
    End Function

    <Extension()> Public Function write_request_body(ByVal o As HttpWebRequest,
                                                     ByVal i As Stream,
                                                     Optional ByVal count As Int64 = npos,
                                                     Optional ByVal comm As link_status = Nothing) As event_comb
        Dim ec As event_comb = Nothing
        Dim os As pointer(Of Stream) = Nothing
        Dim cl As pointer(Of Int64) = Nothing
        Return New event_comb(
                        Function() As Boolean
                            If i Is Nothing OrElse o Is Nothing Then
                                Return False
                            Else
                                If comm Is Nothing Then
                                    comm = link_status.request
                                End If
                                If comm.over_max_content_length(count) Then
                                    Return False
                                Else
                                    os = New pointer(Of Stream)()
                                    ec = o.get_request_stream(os)
                                    Return waitfor(ec, comm.timeout_ms) AndAlso
                                           goto_next()
                                End If
                            End If
                        End Function,
                        Function() As Boolean
                            If ec.end_result() AndAlso Not (+os) Is Nothing Then
                                cl = New pointer(Of Int64)()
                                ec = i.copy_to(+os,
                                               count,
                                               comm.buff_size,
                                               comm.single_copy_timeout_ms,
                                               cl)
                                Return waitfor(ec, comm.copy_timeout_ms) AndAlso
                                       goto_next()
                            Else
                                Return False
                            End If
                        End Function,
                        Function() As Boolean
                            os.get().Close()
                            Return ec.end_result() AndAlso
                                   (count <= 0 OrElse (+cl) = count) AndAlso
                                   goto_end()
                        End Function)
    End Function

    <Extension()> Public Function read_response_body(ByVal i As HttpWebResponse,
                                                     ByVal o As Stream,
                                                     Optional ByVal comm As link_status = Nothing) As event_comb
        Dim cl As pointer(Of Int64) = Nothing
        Dim ec As event_comb = Nothing
        Dim chunked_transfer As Boolean = False
        Dim content_length As Int64 = 0
        Dim s As Stream = Nothing
        Return New event_comb(
                        Function() As Boolean
                            If i Is Nothing OrElse o Is Nothing Then
                                Return False
                            Else
                                If comm Is Nothing Then
                                    comm = link_status.response
                                End If
                                cl = New pointer(Of Int64)()
                                chunked_transfer = i.Headers().chunked_transfer()
                                content_length = If(chunked_transfer, npos, i.ContentLength())
                                If comm.over_max_content_length(content_length) Then
                                    Return False
                                Else
                                    s = i.GetResponseStream()
                                    ec = s.copy_to(o,
                                                   content_length,
                                                   comm.buff_size,
                                                   comm.single_copy_timeout_ms,
                                                   cl)
                                    Return waitfor(ec, comm.copy_timeout_ms) AndAlso
                                           goto_next()
                                End If
                            End If
                        End Function,
                        Function() As Boolean
                            assert(Not s Is Nothing)
                            'the stream is not be able to use any more, so close it
                            s.Close()
                            s.Dispose()
                            Return ec.end_result() AndAlso
                                   (chunked_transfer OrElse (+cl) = content_length) AndAlso
                                   goto_end()
                        End Function)
    End Function

    Private Function parse_response_encoding_from_headers(ByVal h As WebHeaderCollection,
                                                          ByRef o As Encoding) As Boolean
        If h Is Nothing Then
            Return False
        Else
            debugassert(Not h.gzip())
            Return try_get_encoding(h(HttpResponseHeader.ContentEncoding), o) OrElse
                   parse_encoding(h(HttpResponseHeader.ContentType), o)
        End If
    End Function

    Private Function parse_response_encoding_from_meta(ByVal s As String,
                                                       ByRef o As Encoding) As Boolean
        Const regex As String = "<meta.*charset=(.*)"""
        Dim match As RegularExpressions.Match = Nothing
        match = RegularExpressions.Regex.Match(s,
                                               regex,
                                               RegularExpressions.RegexOptions.IgnoreCase Or
                                               RegularExpressions.RegexOptions.Multiline)
        Return match.Success() AndAlso
               Not match.Groups() Is Nothing AndAlso
               match.Groups().Count() = 2 AndAlso
               match.Groups()(1).Success() AndAlso
               try_get_encoding(match.Groups()(1).Value(), o)
    End Function

    Private Function parse_response_encoding_from_pseduo(ByVal s As String,
                                                         ByRef o As Encoding) As Boolean
        Const regex As String = "<?xml.*encoding=""(.*)"""
        Dim match As RegularExpressions.Match = Nothing
        match = RegularExpressions.Regex.Match(s,
                                               regex,
                                               RegularExpressions.RegexOptions.IgnoreCase Or
                                               RegularExpressions.RegexOptions.Multiline)
        Return match.Success() AndAlso
               Not match.Groups() Is Nothing AndAlso
               match.Groups().Count() = 2 AndAlso
               match.Groups()(1).Success() AndAlso
               try_get_encoding(match.Groups()(1).Value(), o)
    End Function

    Private Function parse_response_encoding_from_body(ByVal i As MemoryStream,
                                                       ByRef o As Encoding) As Boolean
        Const readsize As Int32 = 512
        If i Is Nothing OrElse Not i.CanRead() OrElse Not i.CanSeek() Then
            Return False
        Else
            Dim readcount As Int32 = 0
            Dim buff(readsize - 1) As Byte
            assert(i.Seek(0, SeekOrigin.Begin) = 0)
            readcount = i.read(buff, 0, readsize)
            Dim s As String = Nothing
            Return Encoding.ASCII().try_get_string(buff, 0, readcount, s) AndAlso
                   assert(i.Seek(0, SeekOrigin.Begin) = 0) AndAlso
                   (parse_response_encoding_from_meta(s, o) OrElse
                    parse_response_encoding_from_pseduo(s, o))
        End If
    End Function

    Public Function parse_response_encoding(ByVal h As WebHeaderCollection,
                                            ByVal i As MemoryStream,
                                            ByRef o As Encoding,
                                            ByRef gziped As Boolean) As Boolean
        If h Is Nothing Then
            Return False
        Else
            gziped = h.gzip()
            If gziped Then
                Return parse_response_encoding_from_body(i, o)
            Else
                Return parse_response_encoding_from_headers(h, o) OrElse
                       parse_response_encoding_from_body(i, o)
            End If
        End If
    End Function

    Public Function parse_response_body(ByVal h As WebHeaderCollection,
                                        ByVal i As MemoryStream,
                                        ByRef o As String) As Boolean
        If h Is Nothing OrElse i Is Nothing Then
            Return False
        Else
            Dim e As Encoding = Nothing
            Dim gzip As Boolean = False
            If Not parse_response_encoding(h, i, e, gzip) Then
                e = default_encoding
                gzip = False
            End If

            Dim s As Stream = Nothing
            If gzip Then
                s = New GZipStream(i, CompressionMode.Decompress, True)
            Else
                s = i
            End If
            Using r As TextReader = New StreamReader(s, e, False)
                o = r.ReadToEnd()
            End Using
            If gzip Then
                s.Close()
                s.Dispose()
            End If
            Return True
        End If
    End Function

    Public Function generate_url(ByVal host As String,
                                 ByVal port As UInt16,
                                 Optional ByVal path_query As String = constants.uri.path_separator) As String
        If port = default_value.port Then
            Return strcat(protocol_address_head.http, host, path_query)
        Else
            Return strcat(protocol_address_head.http, host, constants.uri.port_mark, port, path_query)
        End If
    End Function

    Public Function try_create_web_request(ByVal uri As String, ByRef o As WebRequest) As Boolean
        Try
            o = WebRequest.Create(uri)
            Return True
        Catch ex As Exception
            raise_error(error_type.warning,
                        "failed to create WebRequest from uri ",
                        uri,
                        ", ex ",
                        ex.Message())
            Return False
        End Try
    End Function

    Public Function try_create_http_web_request(ByVal uri As String, ByRef o As HttpWebRequest) As Boolean
        Dim r As WebRequest = Nothing
        If try_create_web_request(uri, r) Then
            If cast(Of HttpWebRequest)(r, o) Then
                Return True
            Else
                raise_error(error_type.warning, "uri ", uri, " is not an http url")
                r.Abort()
                Return False
            End If
        Else
            Return False
        End If
    End Function

    <Extension()> Public Function to_http_headers(ByVal this(,) As String,
                                                  ByRef o As map(Of String, vector(Of String))) As Boolean
        If isemptyarray(this) OrElse this.GetLength(1) <> 2 Then
            Return False
        Else
            If o Is Nothing Then
                o = New map(Of String, vector(Of String))()
            Else
                o.clear()
            End If
            For i As Int32 = 0 To array_size(this) - 1
                If String.IsNullOrEmpty(this(i, 0)) Then
                    Return False
                End If
                o(this(i, 0)).push_back(this(i, 1))
            Next
            Return True
        End If
    End Function

    <Extension()> Public Function to_http_headers(ByVal this(,) As String) As map(Of String, vector(Of String))
        Dim o As map(Of String, vector(Of String)) = Nothing
        assert(to_http_headers(this, o))
        Return o
    End Function
End Module
